COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	{$NOMAIN	Parser: main part }
C00007 00003	(* Statement parser: stmntParse *)
C00013 00004	(* Called by EDIT: eStmntParse *)
C00015 00005	(* program parser *)
C00018 ENDMK
C⊗;
{$NOMAIN	Parser: main part }

%include palhdr.pas;

{ Externally defined routines from elsewhere: }

	(* From ALLOC *)
function newStatement: statementp;				external;

	(* From PAUX1 *)
function upperCase(c: ascii): ascii;				external;
procedure appendEnd(s,so: statementp);				external;

	(* From PAUX2 *)
procedure errprnt;						external;
procedure ppFlush;						external;

	(* From PTOKEN *)
procedure getToken;						external;

	(* From PBLOCK *)
function blockParse(st: statementp): boolean;			external;
function coblockParse(st: statementp): boolean;			external;
function endParse(st: statementp): boolean;			external;

	(* From POV1 *)
function assignParse(st: statementp): boolean;			external;
function ifParse(st: statementp): boolean;			external;
function forParse(st: statementp): boolean;			external;
function whileParse(st: statementp): boolean;			external;
function untilParse(st: statementp): boolean;			external;
function caseParse(st: statementp): boolean;			external;

	(* From POV2 *)
function returnParse(st: statementp): boolean;			external;
function affixParse(st: statementp): boolean;			external;
function unfixParse(st: statementp): boolean;			external;
function signlParse(st: statementp): boolean;			external;
function pauseParse(st: statementp): boolean;			external;
function printParse(st: statementp): boolean;			external;
function dimensionParse(st: statementp): boolean;		external;

	(* From POV3 *)
function enableParse(st: statementp): boolean;			external;
function stopParse(st: statementp): boolean;			external;
function retryParse(st: statementp): boolean;			external;
function wristParse(st: statementp): boolean;			external;
function requireParse(st: statementp): boolean;			external;
procedure file1Open (fn: c20str);				external;
function defineParse(st: statementp): boolean;			external;

	(* From PCLAUS *)
function clauseParse(absSeen: boolean): nodep;			external;

	(* From PCMON *)
function cmonParse(st: statementp; deferred: boolean): boolean;	external;

	(* From PARMVE *)
function moveParse(st: statementp): boolean;			external;

	(* From PP *)
procedure ppLine; 						external;
procedure ppOutNow; 						external;
procedure ppChar(ch: ascii); 					external;
procedure pp5(ch: c5str; length: integer); 			external;
procedure pp10(ch: cstring; length: integer); 			external;
procedure pp10L(ch: cstring; length: integer);			external;
procedure pp20(ch: c20str; length: integer); 			external;
procedure pp20L(ch: c20str; length: integer); 			external;
procedure ppInt(i: integer); 					external;
procedure ppStrng(length: integer; s: strngp); 			external;

(* Statement parser: stmntParse *)

function stmntParse: statementp; external;
function stmntParse;
 var badstmnt: boolean; st,sp,se: statementp;
 begin
 getToken;			(* get first token in statement *)
 with curToken do
  while (ttype = delimtype) and (ch = ';') do getToken;
 flushcomments := true;		(* don't allow comments anywhere else *)
 endOk := endOk - 1;
 coendOk := coendOk - 1;
 badstmnt := false;		(* assume everything will be fine *)
 st := newStatement;
 with curToken do		(* see what we've got *)
  begin
  if ttype = labeldeftype then
    begin			(* a label *)
    lab↑.s := st;		(* define it *)
    st↑.stlab := lab;		(* copy pointer to label *)
    getToken;			(* move on to start of statement *)
    end
   else st↑.stlab := nil;

  semiseen := false;
  if (ttype = reswdtype) and (rtype = stmnttype) then
    begin
    st↑.stype := stmnt;
    case stmnt of
blocktype:	badstmnt := blockParse(st);
coblocktype:	badstmnt := coblockParse(st);
endtype,
coendtype:	badstmnt := endParse(st);
iftype:		badstmnt := ifParse(st);
fortype:	badstmnt := forParse(st);
whiletype:	badstmnt := whileParse(st);
casetype:	badstmnt := caseParse(st);
returntype:	badstmnt := returnParse(st);
pausetype:	badstmnt := pauseParse(st);
printtype,
prompttype,
aborttype:	badstmnt := printParse(st);

affixtype:	badstmnt := affixParse(st);
unfixtype:	badstmnt := unfixParse(st);
signaltype,
waittype:	badstmnt := signlParse(st);

movetype,
opentype,
closetype,
centertype,
operatetype:	badstmnt := moveParse(st);

stoptype:	badstmnt := stopParse(st);
retrytype:	badstmnt := retryParse(st);
cmtype:		badstmnt := cmonParse(st,false);
enabletype,
disabletype:	badstmnt := enableParse(st);

wristtype:	badstmnt := wristParse(st);

setbasetype:	badstmnt := false;

requiretype:	badstmnt := requireParse(st);

definetype:	badstmnt := defineParse(st);
dimdeftype:	badstmnt := dimensionParse(st);

assigntype:	begin				(* shouldn't get here *)
		badstmnt := true;	(* could try to recover, but... *)
		pp20L('Need a variable to a',20); pp10('ssign to. ',9); ppFlush;
		errprnt;
		end;
otherwise 	{do nothing};
     end
    end
   else if (ttype = reswdtype) and (rtype = filtype) and
	   ((filler = dotype) or (filler = defertype)) then
    begin
    if filler = dotype then badstmnt := untilParse(st)
     else
      begin
      st↑.stype := cmtype;
      getToken;
      if (ttype = reswdtype) and (rtype = stmnttype) and (stmnt = cmtype) then
	badstmnt := cmonParse(st,true)
       else
	begin
	badstmnt := true;
	pp20L('Expecting an ON here',20); ppChar('.'); ppFlush;
	errprnt;
	end
      end
    end
   else if (ttype = identtype) or
	   ((ttype = reswdtype) and (rtype = optype)) then
	 badstmnt := assignParse(st)
   else if ttype = comnttype then
    begin			(* comment *)
    st↑.stype := commenttype;
    st↑.str := str;		(* copy string pointer *)
    st↑.len := len;
    st↑.cbody := nil;
    end
   else 
    begin			(* no good - complain *)
    badstmnt := true;
    pp20L('Can''t start a statem',20); pp20('ent this way.       ',13);
    errprnt;
    end;

  if badstmnt then
    begin
    st↑.stype := emptytype;	(* return empty statement *)
    end;

  while badstmnt do		(* leave things in a "clean" state *)
   begin
   if (ttype = reswdtype) and
	(rtype = stmnttype) and (stmnt <> assigntype) then 
   (* should also maybe stop when we hit a "DO", but then again maybe not *)
     begin badstmnt := false; backup := true end
    else if (ttype = delimtype) and (ch = ';') then badstmnt := false
    else getToken;		(* if still bad try next token *)
   end;
  end;
 stmntParse := st;
 end;

(* Called by EDIT: eStmntParse *)

function eStmntParse(var cblk,newDecs: statementp; cproc: varidefp): statementp; external;
function eStmntParse;
 var s: statementp; i: integer;
 begin					(* parse last line typed at editor *)
 for i := 1 to maxChar+1 do line[i] := listing[i];
	(* ↑ ↑ ↑    This used to be a call to eCopyLine *)
 curChar := 1;
 eofError := false;
 backup := false;
 curToken.next := nil;
 newDeclarations := nil;
 curBlock := cblk;
 outerBlock := cblk;
 while outerBlock↑.bparent <> nil do outerBlock := outerBlock↑.bparent;
 curVariable := nil;
 curProc := cproc;
 curMotion := nil;			(* assume not *)
 curCmon := nil;			(*   ditto    *)
 curErrhandler := nil;			(*   ditto    *)
 endOk := 0;
 coendOk := 0;
 flushcomments := true;
 inCoblock := false;			(* assume we're not *)
 filedepth := 0;
 eStmntParse := stmntParse;		(* go do it *)
 if newDeclarations <> nil then
   begin				(* set things up the way edit expects *)
   s := newDeclarations↑.last;
   while s↑.stype <> blocktype do s := s↑.last;
   s↑.bcode := newDeclarations↑.next;	(* splice new decs out *)
   end;					(* edit will put them back in *)
 newDecs := newDeclarations
 end;

(* program parser *)

function parse(fname: c20str; ppn: integer): statementp; external;
function parse;
 var s,st: statementp; i: integer;
 begin
 macrodepth := 0;
 expandmacros := true;
 curchar := 1;
 maxchar := -1;
 curline := 0;
 curpage := 1;
 eofError := false;
 backup := false;
 curToken.next := nil;
 curBlock := nil;
 outerBlock := nil;
 curVariable := nil;
 curProc := nil;
 curMotion := nil;
 curCmon := nil;
 curErrhandler := nil;
 flushcomments := true;
 dimCheck := false;		(* turn off dimension checking for now *)
 if fname[1] = '*' then filedepth := 0	(* use tty *)
  else
   begin
   filedepth := 1;
   file1Open(fname);		(* Open the file on file1 *)
   getToken;			(* this should flush the E directory *)
   backup := true;
   end;
 errcount := 0;
 s := newStatement;
 with s↑ do
  begin
  stype := progtype;
  pcode := stmntParse;
  if pcode↑.stype <> blocktype then
    begin		(* make sure program enclosed in begin-end block *)
    st := newStatement;
    with st↑ do
     begin
     stype := blocktype;
     bparent := nil;
     blkid := nil;
     variables := nil;
     bcode := s↑.pcode;
     appendEnd(st,bcode);
     end;
    pcode := st;
    end;
  errors := errcount;
  appendEnd(s,pcode);
  end;
 if errcount = 0 then pp20L('No errors detected  ',18)
  else begin pp20L('Errors detected:    ',16); ppInt(errcount) end;
 ppLine;
 parse := s;
 end;